home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / YAGTAPER.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-29  |  8.0 KB  |  281 lines
  1. 10  'YAGTAPER - Yagi Tapered Elements - 24 OCT 96 rev.
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  COMMON EX$
  4. 40  CLS:KEY OFF
  5. 50  COLOR 15,2,1
  6. 60  PRINT " YAGI TAPERED ELEMENTS";TAB(57)"by George Murphy VE3ERP ";
  7. 70  COLOR 1,0:PRINT STRING$(80,223);
  8. 80  COLOR 7,0
  9. 90  '
  10. 100  '...Reserve arrays
  11. 110  MAXPARTS=9
  12. 120  DIM PARTD(MAXPARTS), PARTL(MAXPARTS), LP(MAXPARTS), F(MAXPARTS)
  13. 130  DIM M(MAXPARTS), THETA(MAXPARTS+1)
  14. 140  '
  15. 150  '...Define functions for differential reactance, DELTAX, and
  16. 160  '   total reactance, X.  Coefficients are changed to use natural
  17. 170  '   logarithm instead of base-10 logarithm.  CAPK (CAPital K) is
  18. 180  '   the ratio of wavelength to radius.
  19. 190  DEF FNDELTAX (CAPK)=-18.7*LOG(CAPK)+33.9
  20. 200  DEF FNX (CAPK)=33.25+1.385*LOG(CAPK)-0.066*LOG(CAPK)^2
  21. 210  '
  22. 220  '...Constants
  23. 230  C=11802.8          'Speed of light in inches/microsecond
  24. 240  X$=STRING$(80,32)   'blank line
  25. 250  PIO2=2*ATN(1)       '<0xE3!>/2
  26. 260  U$="####.###"
  27. 270  U1$="###.## "
  28. 280  U2$="##.### "
  29. 290  U3$="####.##"
  30. 300  '
  31. 310  '...start
  32. 320  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  33. 330  ROW=3:COL=2:NUM=7:GOSUB 2170   'print diagram
  34. 340  PRINT STRING$(80,205);
  35. 350  GOSUB 2460  'preface
  36. 360  PRINT STRING$(80,205);
  37. 370  PRINT " Press number in < > to:
  38. 380  PRINT STRING$(80,205);
  39. 390  PRINT "   < 1 > Run program"
  40. 400  PRINT "   < 2 > Run Telescoping Aluminum Tube program"
  41. 410  PRINT "   < 0 > EXIT";
  42. 420  Z$=INKEY$:IF Z$=""THEN 420
  43. 430  IF Z$="0"THEN CLS:RUN EX$
  44. 440  IF Z$="1"THEN VIEW PRINT 9 TO 24:CLS:VIEW PRINT:LOCATE 9:GOTO 480
  45. 450  IF Z$="2"THEN CLS:CHAIN"teletube"
  46. 460  GOTO 420
  47. 470  '
  48. 480  '...Get design data and element tubing dimensions
  49. 490  INPUT " ENTER: Frequency in MHz (7-54 Mhz)........."; FREQ
  50. 500  IF FREQ<7 OR FREQ>54 THEN LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1:GOTO 490
  51. 510  LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1
  52. 520  COLOR 15,1
  53. 530  PRINT " Frequency =";USING U$;FREQ;:PRINT " MHz. (";USING "###.#";300/FREQ;
  54. 540  PRINT "m. )....";TAB(41);
  55. 550  PRINT "1/4 wavelength in free space =";USING U$;3597.51/0.3048/FREQ/2;
  56. 560  PRINT CHR$(34);" ";
  57. 570  COLOR 7,0
  58. 580  LN=CSRLIN
  59. 590  PRINT " Do you want (l)ight, (m)edium, or (h)eavy duty construction?";
  60. 600  PRINT "   (l/m/h) "
  61. 610  Z$=INKEY$:IF Z$=""THEN 610
  62. 620  IF Z$="l"THEN DIAZ=0.375:C$="Light ":GOTO 660
  63. 630  IF Z$="m"THEN DIAZ=0.625:C$="Medium ":GOTO 660
  64. 640  IF Z$="h"THEN DIAZ=0.875:C$="Heavy ":GOTO 660
  65. 650  GOTO 610
  66. 660  LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1,2
  67. 670  PRINT C$;"duty construction selected. Smallest section is";
  68. 680  PRINT USING "##.###";DIAZ+0.125;:PRINT CHR$(34);" in diameter."
  69. 690  INPUT " ENTER: Diameter (inches) of one-piece element to be tapered";IDOL
  70. 700  VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN
  71. 710  PRINT SPC(5);
  72. 720  PRINT "OPEN   LG   OPEN   A   OPEN  A/2  CALL   B   CALL   C   CALL   D   CALL   E   CALL   F   CALL";
  73. 730  PRINT "   G   CALL"
  74. 740  '
  75. 750  SKIP=1        'skip diameter display after first element
  76. 760  GOSUB 2110    'input length
  77. 770  DOL=0.3048*FREQ/3597.51*IDOL    'diameter in wavelengths
  78. 780  '
  79. 790  '...compute section lengths and diameters
  80. 800  L=INCH/2   'halflength
  81. 810  N=INT(L/66)-1
  82. 820  R=(L-N*66)
  83. 830  IF R<72 THEN CNTR=R/2:TIP=CNTR:GOTO 860
  84. 840  IF R>102 THEN N=N+1:GOTO 820
  85. 850  CNTR=36     '1/2 centre section
  86. 860  TIP=R-CNTR  'end section
  87. 870  '...section length
  88. 880  FOR I=1 TO N+2
  89. 890   IF I=1 THEN PARTL(I)=CNTR:GOTO 920
  90. 900   IF I=N+2 THEN PARTL(I)=0:GOTO 920
  91. 910   PARTL(I)=66
  92. 920  NEXT I
  93. 930  '...section diameter
  94. 940  Z=DIAZ         'diameter data base
  95. 950  FOR I=N+2 TO 1 STEP-1
  96. 960   Z=Z+0.125
  97. 970   PARTD(I)=Z
  98. 980  NEXT I
  99. 990  NPARTS=N+2
  100. 1000  LN2=CSRLIN
  101. 1010   FOR Z=NPARTS*8+27 TO 79  'ERASE UNUSED COLUMNS
  102. 1020   LOCATE LN,Z:PRINT " ";
  103. 1030   NEXT Z
  104. 1040  VIEW PRINT 3 TO 8:CLS:VIEW PRINT
  105. 1050  ROW=3:COL=2:NUM=NPARTS
  106. 1060  GOSUB 2170   'print diagrams
  107. 1070  COLOR 0,7:LOCATE 4,2:PRINT NUM*2-1;"piece"
  108. 1080  LOCATE ,3:PRINT C$
  109. 1090  LOCATE ,3:PRINT "Duty"
  110. 1100  LOCATE ,3:PRINT "Element":COLOR 7,0
  111. 1110  LOCATE LN2
  112. 1120  LAMBDA=C/FREQ
  113. 1130  '
  114. 1140  '...Alter halflength to scale from design diameter to the
  115. 1150  '   geometric average of the root and end piece diameters
  116. 1160  AVGDIA=SQR(PARTD(1)*PARTD(NPARTS))
  117. 1170  ADOL=AVGDIA/LAMBDA
  118. 1180  CAPK=2/DOL
  119. 1190  ACAPK=2/ADOL
  120. 1200  SML=2*HOL
  121. 1210  ASML=(FNX(ACAPK)-FNX(CAPK)-20*FNDELTAX(CAPK)*(0.5-SML))/(20*FNDELTAX(ACAPK))
  122. 1220  ASML=0.5+ASML
  123. 1230  HAOL=ASML/2
  124. 1240  HA=HAOL*LAMBDA
  125. 1250  '
  126. 1260  '...Set up Lawson's M functions for each piece
  127. 1270  FOR I=1 TO NPARTS
  128. 1280      PDIA=PARTD(I)/LAMBDA
  129. 1290      CAPI=2/PDIA
  130. 1300      M(I)=FNDELTAX(CAPI)/FNDELTAX(ACAPK)
  131. 1310      NEXT I
  132. 1320  '
  133. 1330  '...Set up initial guess for the length of the end part
  134. 1340  PARTL(NPARTS)=HA
  135. 1350  FOR I=1 TO NPARTS-1
  136. 1360      PARTL(NPARTS)=PARTL(NPARTS)-PARTL(I)
  137. 1370      NEXT I
  138. 1380  THETA(NPARTS+1)=PIO2
  139. 1390  '
  140. 1400  '...Compute the cylindrical element which is equivalent to the
  141. 1410  '   assumed tapered element, adjust the end piece length proportionally
  142. 1420  '   to the error between the computed cylinder length and target length
  143. 1430  '   (HA), iterate until the error is small
  144. 1440  DELTA=1
  145. 1450  WHILE ABS(DELTA)>9.999E-06*HA
  146. 1460    'Find the total half-length of the tapered element.
  147. 1470   S=0
  148. 1480   FOR I=1 TO NPARTS
  149. 1490    S=S+PARTL(I)
  150. 1500    THETA(I)=0
  151. 1510   NEXT I
  152. 1520   SRAD=S/PIO2
  153. 1530    'Compute the positions of the joints in radians
  154. 1540   FOR I=2 TO NPARTS
  155. 1550    THETA(I)=THETA(I-1)+PARTL(I-1)/SRAD
  156. 1560   NEXT I
  157. 1570    'Evaluate Lawson's F function and determine the
  158. 1580    'equivalent length of each piece
  159. 1590   FOR I=1 TO NPARTS
  160. 1600    F(I)=(SIN(2*THETA(I+1))-SIN(2*THETA(I)))/(2*(THETA(I+1)-THETA(I)))
  161. 1610    LP(I)=PARTL(I)*(M(I)+1/M(I)+(M(I)-1/M(I))*F(I))/2
  162. 1620   NEXT I
  163. 1630    'Find the error between the sum of the equivalent
  164. 1640    'piece lengths and the target length
  165. 1650   DELTA=HA
  166. 1660   FOR I=1 TO NPARTS
  167. 1670    DELTA=DELTA-LP(I)
  168. 1680   NEXT I
  169. 1690    'Add the error to the end piece and loop back
  170. 1700   PARTL(NPARTS)=PARTL(NPARTS)+M(NPARTS)*DELTA
  171. 1710  WEND
  172. 1720  '
  173. 1730  '...Show the results, then go back to do another case with the same
  174. 1740  '   design parameters except halflength, and the same tubing schedule
  175. 1750  '
  176. 1760  IF SKIP=1 THEN GOSUB 1950:SKIP=0   'print diameters
  177. 1770  GOSUB 2030  'print reference element
  178. 1780  PRINT "     ";USING"OPEN####.## OPEN";S;:PRINT USING U1$;PARTL(1)*2;:PRINT "OPEN";
  179. 1790  FOR I=1 TO NPARTS
  180. 1800  IF I=NPARTS THEN COLOR 15,1
  181. 1810  PRINT USING U1$;PARTL(I);:COLOR 7,0:PRINT "CALL";
  182. 1820  COLOR 7,0
  183. 1830  NEXT I:PRINT ""
  184. 1840  SKIP=0
  185. 1850  '
  186. 1860  PRINT " Convert another element ?  (y/n)"
  187. 1870  Z$=INKEY$:IF Z$=""THEN 1870
  188. 1880  IF Z$="n"OR Z$="y"THEN LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1
  189. 1890  IF Z$="n"THEN 1920
  190. 1900  IF Z$="y"THEN GOSUB 2120:GOTO 1130
  191. 1910  GOTO 1870
  192. 1920  GOSUB 2680:GOTO 310
  193. 1930  END
  194. 1940  '
  195. 1950  '...print diameters
  196. 1960  PRINT " Dia.OPEN varies OPEN";USING U2$;PARTD(1);:PRINT "OPEN";
  197. 1970  FOR I=1 TO NPARTS
  198. 1980  PRINT USING U2$;PARTD(I);:PRINT "CALL";
  199. 1990  NEXT I:PRINT ""
  200. 2000  SKIP=0
  201. 2010  RETURN
  202. 2020  '
  203. 2030  '...print ref. element specs.
  204. 2040  COLOR 0,7:LOCATE CSRLIN,2
  205. 2050  PRINT USING"##.###";IDOL;:PRINT CHR$(34);" diameter one-piece element";
  206. 2060  PRINT USING U3$;INCH;:PRINT CHR$(34);" long (halflength";USING U3$;INCH/2;
  207. 2070  PRINT CHR$(34);") becomes: "
  208. 2080  COLOR 7,0
  209. 2090  RETURN
  210. 2100  '
  211. 2110  '...input length
  212. 2120  INPUT " ENTER: End-to-end full length of one-piece element (inches) ";INCH
  213. 2130  LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1
  214. 2140  HOL=0.3048*FREQ/3597.51*INCH/2   'halflength in wavelengths
  215. 2150  RETURN
  216. 2160  '
  217. 2170  '...diagrams
  218. 2180  LOCATE ROW
  219. 2190  COLOR 15,7
  220. 2200  LOCATE ,COL:PRINT "      ALL DIMENSIONS IN INCHES        "
  221. 2210  COLOR 0,7
  222. 2220  LOCATE ,COL:PRINT "                     CALLDEFSNGSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND LG SOUNDDEFDBLCALL"
  223. 2230  LOCATE ,COL:PRINT "             CALLDEFSNGSOUNDSOUNDSOUNDSOUNDSOUND A SOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLCALL       CALL"
  224. 2240  LOCATE ,COL:PRINT "          <UNK! {00F7}>SOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBEEPSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR"
  225. 2250  LOCATE ,COL:PRINT "          <UNK! {00F7}>SOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'"
  226. 2260  LOCATE ,COL:PRINT "     element centreSOUNDSOUND'DEFSNGSOUNDA/2SOUNDDEFDBLCALLDEFSNGSOUND B SOUNDDEFDBLCALL"
  227. 2270  COLOR 7,0
  228. 2280  COL=COL+28
  229. 2290  FOR Z=3 TO NUM:COL=COL+8
  230. 2300  A$=" "+CHR$(Z+64)+" "
  231. 2310  GOSUB 2350
  232. 2320  NEXT Z
  233. 2330  RETURN
  234. 2340  '
  235. 2350  COLOR 0,7
  236. 2360  LOCATE ROW
  237. 2370  LOCATE ,COL:PRINT "          "
  238. 2380  LOCATE ,COL:PRINT "SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDDEFDBLCALL"
  239. 2390  LOCATE ,COL:PRINT "         CALL"
  240. 2400  LOCATE ,COL:PRINT "SOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR"
  241. 2410  LOCATE ,COL:PRINT "SOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'"
  242. 2420  LOCATE ,COL:PRINT "DEFDBLCALLDEFSNGSOUND";A$;"SOUNDDEFDBLCALL"
  243. 2430  COLOR 7,0
  244. 2440  RETURN
  245. 2450  '
  246. 2460  '...preface
  247. 2470  TB=8
  248. 2480  PRINT TAB(TB);
  249. 2490  PRINT "This program converts cylindrical elements to equivalent tapered"
  250. 2500  PRINT TAB(TB);
  251. 2510  PRINT "elements by computing the length of the end pieces using Lawson's"
  252. 2520  PRINT TAB(TB);
  253. 2530  PRINT "method (Yagi Antenna Design). The program is based on TAPER.BAS by"
  254. 2540  PRINT TAB(TB);
  255. 2550  PRINT "Bill Myers, K1GQ, as published in The ARRL ANTENNA BOOK, 17th"
  256. 2560  PRINT TAB(TB);
  257. 2570  PRINT "edition, pp. 2-29 to 2-31. The diagram above shows one-half of a"
  258. 2580  PRINT TAB(TB);
  259. 2590  PRINT "typical element."
  260. 2600  PRINT
  261. 2610  PRINT TAB(TB);
  262. 2620  PRINT "Calculations are for .058";CHR$(34);" wall aluminum tube sections";
  263. 2630  PRINT " with a "
  264. 2640  PRINT TAB(TB);
  265. 2650  PRINT "maximum length of 72 inches (one-half standard 12 foot length).
  266. 2660  RETURN
  267. 2670  '
  268. 2680  'HARDCOPY
  269. 2690  GOSUB 2800:LOCATE 25,2:COLOR 14,6
  270. 2700  PRINT " Press 1 to print screen, 2 to print screen & ";
  271. 2710  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  272. 2720  Z$=INKEY$:IF Z$="3"THEN GOSUB 2800:RETURN
  273. 2730  IF Z$="1"OR Z$="2"THEN GOSUB 2800:GOTO 2750
  274. 2740  GOTO 2720
  275. 2750  FOR QX=1 TO 24:FOR QY=1 TO 80
  276. 2760  LPRINT CHR$(SCREEN(QX,QY));
  277. 2770  NEXT QY:NEXT QX
  278. 2780  IF Z$="2"THEN LPRINT CHR$(12)
  279. 2790  GOTO 2690
  280. 2800  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  281.